home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / HTML and CSS Modes / htmlEngine.tcl < prev    next >
Encoding:
Text File  |  2001-01-12  |  46.1 KB  |  1,450 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlEngine.tcl"
  6.  #                                    created: 99-07-17 14.03.18 
  7.  #                                last update: 00-12-31 16.14.38 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <alpha_www_tools@go.to>
  10.  #     www: <http://go.to/alpha_www_tools>
  11.  #  
  12.  # Version: 3.0
  13.  # 
  14.  # Copyright 1996-2001 by Johan Linde
  15.  #  
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # 
  30.  # ###################################################################
  31.  ##
  32.  
  33. #===============================================================================
  34. # This file contains the main procs building elements and for handling 
  35. # the attribute dialogs.
  36. #===============================================================================
  37.  
  38. #===============================================================================
  39. # ◊◊◊◊ Element building routines ◊◊◊◊ #
  40. #===============================================================================
  41.  
  42. proc html::Tag {elem {option ""}} {
  43.     global html::ElemLayout html::Plugins
  44.     if {[html::IsInContainer STYLE]} {
  45.         if {[lcontains html::Plugins $elem]} {set elem EMBED}
  46.         if {[regexp {INPUT TYPE=} $elem]} {set elem INPUT}
  47.         replaceText [getPos] [selEnd] $elem
  48.         return
  49.     }
  50.     set elem2 $elem
  51.     if {[regexp {INPUT TYPE=} $elem]} {set elem2 INPUT}
  52.     if {[lcontains html::Plugins $elem]} {set elem2 EMBED}
  53.     switch [set html::ElemLayout($elem2)] {
  54.         open00 {html::BuildOpening $elem 0 0 $option}
  55.         open10 {html::BuildOpening $elem 1 0 $option}
  56.         open01 {html::BuildOpening $elem 0 1 $option}
  57.         open11 {html::BuildOpening $elem 1 1 $option}
  58.         nocr   {html::BuildElem $elem $option}
  59.         cr0    {html::BuildCRElem $elem 0 $option}
  60.         cr1    {html::BuildCRElem $elem 1 $option}
  61.         cr2    {html::BuildCR2Elem $elem $option}
  62.     }
  63. }
  64.  
  65. # Closing tag of an element
  66. proc html::CloseElem {elem} {
  67.     return "</[html::SetCase $elem]>"
  68. }
  69.  
  70. proc html::SetCase {elem} {
  71.     global HTMLmodeVars 
  72.     if {$HTMLmodeVars(useLowerCase)} { 
  73.         return [string tolower $elem] 
  74.     } else {
  75.         return [string toupper $elem] 
  76.     }
  77. }
  78.  
  79. # Build elements with only a opening tag.
  80. proc html::BuildOpening {elem {begCR 0} {endCR 0} {attr ""}} {
  81.     global html::Plugins
  82.     set text ""
  83.     if {$begCR} { 
  84.         set text [html::OpenCR]
  85.     }
  86.     if {[lcontains html::Plugins $elem]} {set attr $elem; set elem EMBED}
  87.     set pos [expr {[string length $text] ? [string length [text::maxSpaceForm [text::indentString [getPos]]]] : -1}]
  88.     if {[set text1 [html::OpenElem $elem $attr $pos]] == ""} {return}
  89.     append text $text1
  90.     if {$endCR} {
  91.         set text2 [html::CloseCR]
  92.         append text $text2
  93.     }
  94.     html::elecInsertion text
  95. }
  96.  
  97.  
  98. # This is used for almost all containers
  99. proc html::BuildElem {ftype {attr ""}} {
  100.     global HTMLmodeVars htmlCurSel htmlIsSel
  101.     
  102.     if {[set text [html::OpenElem $ftype $attr]] == ""} {return}
  103.     html::GetSel
  104.     if {$htmlIsSel} {
  105.         append text $htmlCurSel
  106.     } else {
  107.         append text "•content•"
  108.     }
  109.     append text [html::CloseElem $ftype]
  110.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•end•"}
  111.     if {$htmlIsSel} {
  112.         elec::ReplaceText [getPos] [selEnd] $text
  113.     } else {
  114.         HTML::indentLine
  115.         if {[pos::compare [set p [lindex [text::firstNonWsLinePos [getPos]] 0]] > [getPos]]} {goto $p}
  116.         elec::Insertion $text
  117.     }
  118. }
  119.  
  120. # This is used for elements that should be surrounded by newlines
  121. proc html::BuildCRElem {ftype {extrablankline 0} {attr ""}} {
  122.     global htmlCurSel htmlIsSel HTMLmodeVars
  123.     
  124.     html::GetSel
  125.     set ind [string length [text::maxSpaceForm [text::indentString [getPos]]]]
  126.     if {$htmlIsSel} {
  127.         set htmlCurSel [text::indentBy $htmlCurSel [expr {-$ind}]]
  128.     }    
  129.     if {[set text2 [html::OpenElem $ftype $attr $ind]] == ""} {return}
  130.     if {$htmlIsSel} { deleteSelection }
  131.     if {[is::Whitespace [getText [lineStart [getPos]] [getPos]]]
  132.     && [pos::compare [lineStart [getPos]] > [minPos]]} {goto [pos::math [lineStart [getPos]] - 1]}
  133.     set text [html::OpenCR $extrablankline]
  134.     append text $text2
  135.     if {$htmlIsSel} {
  136.         append text $htmlCurSel
  137.     } else {
  138.         append text "•content•"
  139.     }
  140.     append text [html::CloseElem $ftype]
  141.     set text2 ""
  142.     if {$extrablankline} {
  143.         set text2 [html::CloseCR2 [selEnd]]
  144.     } else {
  145.         set text2 [html::CloseCR]
  146.     }
  147.     append text $text2
  148.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•end•"}
  149.     html::elecInsertion text
  150. }
  151.  
  152. # This is used for elements that should be surrounded by empty lines
  153. proc html::BuildCR2Elem {ftype {attr ""}} {
  154.     global HTMLmodeVars htmlCurSel htmlIsSel
  155.     
  156.     html::GetSel
  157.     set ind [string length [text::maxSpaceForm [text::indentString [getPos]]]]
  158.     if {$htmlIsSel} {
  159.         set htmlCurSel [text::indentBy $htmlCurSel [expr {-$ind}]]
  160.     }    
  161.     if {[set text1 [html::OpenElem $ftype $attr $ind]] == ""} {return}
  162.     if {$htmlIsSel} { deleteSelection }
  163.     if {[is::Whitespace [getText [lineStart [getPos]] [getPos]]]
  164.     && [pos::compare [lineStart [getPos]] > [minPos]]} {goto [pos::math [lineStart [getPos]] - 1]}
  165.     set text [html::OpenCR 1]
  166.     append text $text1
  167.     set cr [html::CRcharacter]
  168.     set text0 $cr
  169.     if {$ftype == "SCRIPT" || $ftype == "STYLE"} {
  170.         append text0 "<!--$cr"
  171.     }
  172.     if {$htmlIsSel} {
  173.         append text0 $htmlCurSel
  174.     } else {
  175.         append text0 "•content•"
  176.     }
  177.     if {[lcontains HTMLmodeVars(indentElements) $ftype]} {
  178.         regsub -all $cr $text0 "\r\t" text0
  179.     }
  180.     append text $text0
  181.     set pre(SCRIPT) "// "; set pre(STYLE) "";
  182.     if {$ftype == "SCRIPT" || $ftype == "STYLE"} {
  183.         set text0 "\r$pre($ftype)-->"
  184.         if {[lcontains HTMLmodeVars(indentElements) $ftype]} {
  185.             regsub -all "\r" $text0 "\r\t" text0
  186.         }
  187.         append text $text0
  188.     }
  189.     append text \r [html::CloseElem $ftype] [html::CloseCR2 [selEnd]]
  190.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•end•"}
  191.     html::elecInsertion text
  192. }
  193.  
  194. # Returns one or two carriage returns at the insertion point if any
  195. # character preceding the insertion point (on the same line)
  196. # is a non-whitespace character.
  197. proc html::OpenCR {{extrablankline 0} {etxt ""}} {
  198.     set end [getPos]
  199.     set start [lineStart $end]
  200.     set text [getText $start $end]
  201.     if {![is::Whitespace $text]} {
  202.         set r "\r$etxt"
  203.         if {$extrablankline} {append r "\r$etxt"}
  204.         return $r
  205.     } elseif {[pos::compare $start > [minPos]] } { 
  206.         set prevstart [lineStart [pos::math $start - 1 ]]
  207.         set text [getText $prevstart [pos::math $start - 1]]
  208.         if {![is::Whitespace $text] && $extrablankline} {
  209.             return "\r$etxt"
  210.         } else { 
  211.             return ""
  212.         }
  213.     } else {
  214.         return ""
  215.     }
  216. }
  217.  
  218. # Insert a carriage return at the insertion point if any
  219. # character following the insertion point (on the same line)
  220. # is a non-whitespace character.
  221. proc html::CloseCR {{start ""}} {
  222.     if {$start == ""} {set start [selEnd]}
  223.     if {![is::Whitespace [getText $start [nextLineStart $start]]]} {
  224.         return "\r"
  225.     }
  226.     return ""
  227. }
  228.  
  229. # Insert up to two carriage return at the insertion point depending
  230. # on how many blank lines there are after the insertion point.
  231. proc html::CloseCR2 {pos {etxt ""}} {
  232.     set blank1 [is::Whitespace [getText $pos [nextLineStart $pos]]]
  233.     set blank2 [is::Whitespace [getText $pos [nextLineStart [nextLineStart $pos]]]]
  234.     if {!$blank1} {
  235.         return "\r$etxt\r"
  236.     } elseif {!$blank2} {
  237.         return "\r"
  238.     }
  239.     return ""
  240. }
  241.  
  242. # A couple of functions to get element variables from the right package.
  243. proc html::GetSomeAttrs {item type} {
  244.     global html::Elem${type}
  245.     if {[catch {set atts [set html::Elem${type}($item)]}]} { 
  246.         set atts {} 
  247.     }
  248.     return $atts
  249. }    
  250.  
  251. proc html::GetRequired {item} {
  252.     return [html::GetSomeAttrs $item AttrRequired]
  253. }
  254.  
  255. proc html::GetUsed {item {reqatts ""} {optatts ""} {arr 0}} {
  256.     global HTMLmodeVars
  257.     set useatts [html::GetSomeAttrs $item AttrUsed]
  258.     if {$arr} {return $useatts}
  259.     if {$reqatts == ""} {set reqatts [html::GetRequired $item]}
  260.     if {$optatts == ""} {set optatts [html::GetOptional $item]}
  261.     set over [html::GetOverride $item]
  262.     set exp "\[ \n\r\t]+([join $over |])"
  263.     regsub -all $exp " $HTMLmodeVars(alwaysaskforAttributes)" " " alwaysask
  264.     regsub -all $exp " $HTMLmodeVars(dontaskforAttributes)" " " dontask
  265.     set exp "\[ \n\r\t]+([join [concat $useatts $alwaysask] |])"
  266.     regsub -all $exp " $optatts" " " opt1
  267.     set exp "\[ \n\r\t]+([join $opt1 |])"
  268.     regsub -all $exp " $optatts" " " useatts
  269.     set exp "\[ \n\r\t]+([join $dontask |])"
  270.     regsub -all $exp " $useatts" " " useatts
  271.     return [concat $reqatts $useatts]
  272. }
  273.  
  274. proc html::GetHidden {item} {
  275.     return [html::GetSomeAttrs $item AttrHidden]
  276. }
  277.  
  278. proc html::GetExtensions {item} {
  279.     return [html::GetSomeAttrs $item Extension]
  280. }
  281.  
  282. proc html::GetDeprecated {item} {
  283.     return [html::GetSomeAttrs $item Deprecated]
  284. }
  285.  
  286. proc html::GetOverride {item} {
  287.     return [html::GetSomeAttrs $item AttrOverride]
  288. }
  289.  
  290. proc html::GetOptional {item {all 0}} {
  291.     global HTMLmodeVars html::HideDeprecated html::HideExtensions
  292.     set attrs [html::GetSomeAttrs $item AttrOptional]
  293.     if {$all} {return $attrs}
  294.     set hidden [html::GetHidden $item]
  295.     set over [html::GetOverride $item]
  296.     set exp1 "\[ \n\r\t]+([join $over |])"
  297.     regsub -all $exp1 " $HTMLmodeVars(alwaysaskforAttributes)" " " alwaysask
  298.     regsub -all $exp1 " $HTMLmodeVars(dontaskforAttributes)" " " dontask
  299.     regsub -all $exp1 " $HTMLmodeVars(neveraskforAttributes)" " " neverask
  300.     set exp1 "\[ \n\r\t]+([join $alwaysask |])"
  301.     regsub -all $exp1 " $hidden" " " hidden
  302.     set exp "\[ \n\r\t]+([join $dontask |])"
  303.     regsub -all $exp " $hidden" " " hidden
  304.     set exp "\[ \n\r\t]+([join $hidden |])"
  305.     regsub -all $exp " $attrs" " " attrs
  306.     set exp "\[ \n\r\t]+([join $neverask |])"
  307.     regsub -all $exp " $attrs" " " attrs
  308.     if {${html::HideDeprecated} || $HTMLmodeVars(hideDeprecated)} {
  309.         set exp "\[ \n\r\t]+([join [concat [html::GetExtensions $item] [html::GetDeprecated $item]] |])"
  310.         regsub -all $exp " $attrs" " " attrs
  311.         if {${html::HideDeprecated}} {regsub "TARGET=" $attrs " " attrs}
  312.     } elseif {${html::HideExtensions} || $HTMLmodeVars(hideExtensions)} {
  313.         set exp "\[ \n\r\t]+([join [html::GetExtensions $item] |])"
  314.         regsub -all $exp " $attrs" " " attrs
  315.     }
  316.     return $attrs
  317. }
  318.  
  319. proc html::GetEventHandlers {elem} {
  320.     global html::AttrType
  321.     set attrs ""
  322.     foreach a [html::GetOptional $elem] {
  323.         if {[html::GetAttrType $elem $a] == "eventhandler"} {
  324.             lappend attrs $a
  325.         }
  326.     }
  327.     return $attrs
  328. }
  329.  
  330.  
  331. proc html::GetSomeAttrDef {type elem attr} {
  332.     global html::Attr$type
  333.     if {[info exists html::Attr${type}($elem%$attr)]} {
  334.         return [set html::Attr${type}($elem%$attr)]
  335.     } else {
  336.         return [set html::Attr${type}($attr)]
  337.     }
  338.     
  339. }
  340.  
  341. proc html::GetAttrChoices {elem attr} {
  342.     return [html::GetSomeAttrDef Choices $elem $attr]
  343. }
  344.  
  345. proc html::GetAttrType {elem attr} {
  346.     return [html::GetSomeAttrDef Type $elem $attr]
  347. }
  348.  
  349. proc html::GetAttrRange {elem attr} {
  350.     return [html::GetSomeAttrDef Range $elem $attr]
  351. }
  352.  
  353. proc html::GetAttrOfType {type} {
  354.     global html::AttrType
  355.     foreach a [array names html::AttrType] {
  356.         if {[set html::AttrType($a)] == $type} {lappend attrs $a}
  357.     }
  358.     return $attrs
  359. }
  360.  
  361. proc html::GetURLAttrs {} {
  362.     return [html::GetAttrOfType url]
  363. }
  364.  
  365. proc html::GetColorAttrs {} {
  366.     return [html::GetAttrOfType color]
  367. }
  368.  
  369. proc html::GetExcludedElems {} {
  370.     global HTMLmodeVars html::HideDeprecated html::HideExtensions html::HideFrames
  371.     global html::NotInStrict html::NotInTransitional html::HTMLextensions html::DeprecatedElems
  372.     set elems ""
  373.     if {${html::HideExtensions} || ${html::HideDeprecated} || $HTMLmodeVars(hideDeprecated) || $HTMLmodeVars(hideExtensions)} {
  374.         set elems ${html::HTMLextensions}
  375.     }
  376.     if {${html::HideFrames}} {
  377.         append elems " " ${html::NotInTransitional}
  378.     }
  379.     if {${html::HideDeprecated}} {
  380.         append elems " " ${html::NotInStrict}
  381.     }
  382.     if {$HTMLmodeVars(hideDeprecated)} {
  383.         append elems " " ${html::DeprecatedElems}
  384.     }
  385.     return [lunique $elems]
  386. }
  387.  
  388. proc html::OpenElem {elem {used ""} {pos -1}} {
  389.     global HTMLmodeVars 
  390.     if {$HTMLmodeVars(useBigWindows)} {
  391.         return [html::OpenElemWindow $elem $used $pos]
  392.     } else {
  393.         return [html::OpenElemStatusBar $elem $used $pos]
  394.     }
  395. }
  396.  
  397. # Opening or only tag of an element - include attributes
  398. # Big window with all attributes.
  399. # Return empty string if user clicks "Cancel".
  400. proc html::OpenElemWindow {elem used wrPos {values ""} {addNotUsed 0} {addHidden 0} {absPos ""}} {
  401.     global html::WrapPos html::AbsPos
  402.     
  403.     if {![string length $used]} {set used $elem}
  404.     set elem [string toupper $elem]
  405.     set used [string toupper $used]
  406.     
  407.     # get variables for the element
  408.     set reqatts [html::GetRequired $used]
  409.     set optatts [html::GetOptional $used]
  410.     set allatts [html::GetUsed $used $reqatts $optatts]
  411.     regsub -all "\[ \n\r\t]+([join $allatts |])" " $optatts" " " notUsedAtts
  412.     if {$addNotUsed} {
  413.         append allatts " $notUsedAtts"
  414.         set notUsedAtts ""
  415.     }
  416.     if {$addHidden} {
  417.         regsub -all "\[ \n\r\t]+([join $optatts |])" " [html::GetOptional $used 1]" " " hiddenAtts
  418.         append allatts " $hiddenAtts"
  419.     }
  420.     
  421.     set text "<"
  422.     append text [html::SetCase $elem]
  423.     # trick for INPUT
  424.     regsub {TYPE=(.*)$} $text "TYPE=\"\\1\"" text
  425.     
  426.     if {![llength $allatts]} {return "$text>"}
  427.     
  428.     set maxHeight [expr {[lindex [getMainDevice] 3] - 115}]
  429.     set thisPage "Page 1"
  430.     
  431.     set widthIndex -1
  432.     set heightIndex -1
  433.     if {$absPos == ""} {
  434.         set html::AbsPos [getPos]
  435.     } else {
  436.         set html::AbsPos $absPos
  437.     }
  438.     
  439.     # build window with attributes 
  440.     set invalidInput 1
  441.     while {$invalidInput} {
  442.         # wrapping
  443.         set html::WrapPos [expr {$wrPos == -1 ? [posX [getPos]] : $wrPos}]
  444.         incr html::WrapPos [expr {[string length $text] + 1}]
  445.         while {1} {
  446.             set pr $elem
  447.             if {$elem == "EMBED" && $used != "EMBED"} {append pr ", $used"}
  448.             set box1 ""; set box2 ""; set box3 ""
  449.             set page 1
  450.             set wpos 10
  451.             if {[string length $reqatts]} {
  452.                 lappend box$page -t {Required attributes} 10 35 200 50
  453.                 set hpos 60
  454.             } else {
  455.                 set hpos 30
  456.             }
  457.             set attrIndex 2
  458.             set buttons ""
  459.             for {set i 0} {$i < [llength $allatts]} {incr i} {
  460.                 set attr [lindex $allatts $i]
  461.                 if {$i == [llength $reqatts]} {
  462.                     if {$wpos > 20} { incr hpos 20 }
  463.                     lappend box$page -t {Optional attributes} 10 [expr {$hpos + 5}] 200 [expr {$hpos + 20}]
  464.                     set wpos 10
  465.                     incr hpos 30
  466.                 }
  467.                 set attrType [html::GetAttrType $used $attr]
  468.                 if {[catch {eval html::BuildDialog$attrType [list $used] $attr values box$page hpos wpos buttons buttonAction attrIndex $maxHeight}]} {
  469.                     incr page
  470.                     set hpos 40
  471.                     set wpos 10
  472.                     eval html::BuildDialog$attrType [list $used] $attr values box$page hpos wpos buttons buttonAction attrIndex $maxHeight
  473.                 }
  474.             }
  475.             if {$wpos > 20} { incr hpos 25 }
  476.             
  477.             set box ""
  478.             if {[info tclversion] < 8.0} {set box "-t {Attributes for $pr} 120 10 450 25 "}
  479.             if {$page == 1} {
  480.                 append box $box1
  481.             } elseif {$page == 2} {
  482.                 set hpos $maxHeight
  483.                 append box " -m \{\{$thisPage\} \{Page 1\} \{Page 2\}\} 10 10 85 30 -n \{Page 1\} $box1 -n \{Page 2\} $box2"
  484.             } elseif {$page == 3} {
  485.                 set hpos $maxHeight
  486.                 append box " -m \{\{$thisPage\} \{Page 1\} \{Page 2\} \{Page 3\}\} 10 10 85 30 -n \{Page 1\} $box1 -n \{Page 2\} $box2 -n \{Page 3\} $box3"
  487.             }
  488.             # Add More button if hidden attrs
  489.             set moreButton 0
  490.             if {[llength $notUsedAtts]} {
  491.                 set box " -b More… 200 [expr {$hpos + 20}] 265 [expr {$hpos + 40}] $box"
  492.                 set moreButton 1
  493.             }
  494.             if {[info tclversion] >= 8.0} {append box " -T {Attributes for $pr}"}
  495.             set values [eval [concat dialog -w 460 -h [expr {$hpos + 50}] \
  496.               -b OK 20 [expr {$hpos + 20}]  85 [expr {$hpos + 40}] \
  497.               -b Cancel 110 [expr {$hpos + 20}] 175 [expr {$hpos + 40}] $box]]
  498.             
  499.             # More button clicked?
  500.             if {$moreButton && [lindex $values 2]} {
  501.                 append allatts " $notUsedAtts"
  502.                 set notUsedAtts ""
  503.             }
  504.             # If more button...
  505.             if {$moreButton} {
  506.                 set values [lreplace $values 2 2]
  507.             }
  508.             # If two pages...
  509.             if {$page > 1} {
  510.                 set thisPage [lindex $values 2]
  511.                 set values [lreplace $values 2 2]
  512.             }
  513.             # OK button clicked?
  514.             if {[lindex $values 0] } { break }
  515.             # Cancel button clicked?
  516.             if {[lindex $values 1] } { return}
  517.             # Another button clicked
  518.             foreach b $buttons {
  519.                 if {[lindex $values $b]} {eval $buttonAction($b) values $b}
  520.             }
  521.         }
  522.         
  523.         
  524.         # put everything together
  525.         set attrtext ""
  526.         set errtext ""
  527.         
  528.         set j 2
  529.         for {set i 0} {$i < [llength $allatts]} {incr i} {
  530.             set attr [lindex $allatts $i]
  531.             set currerr $errtext
  532.             set atext [eval html::ReadDialog[html::GetAttrType $used $attr] [list $elem] $attr values j errtext]
  533.             if {$atext == "" && [lcontains reqatts $attr]} {
  534.                 if {$currerr == $errtext} {lappend errtext "$attr required."}
  535.             } else {
  536.                 append attrtext $atext
  537.             }
  538.         }
  539.         # If everything is OK, add the attribute text to text.
  540.         if {![llength $errtext]} {
  541.             if {([info commands html::${elem}test] == "" && [info commands ::html::${elem}test] == "") || ![eval html::${elem}test $elem [list "$text$attrtext"] alertnote]} { 
  542.                 append text $attrtext
  543.                 set invalidInput 0
  544.             }
  545.         } else {
  546.             # Put up alert with the error text.
  547.             html::ErrorWindow "Invalid input for $used" $errtext
  548.         }
  549.     }
  550.     
  551.     if {[string length $text] } {append text ">"}
  552.     
  553.     return ${text}
  554. }
  555.  
  556. proc html::WrapTag {toadd} {
  557.     global fillColumn HTMLmodeVars html::WrapPos html::AbsPos
  558.     if {!$HTMLmodeVars(wordWrap)} {return " $toadd"}
  559.     incr html::WrapPos [string length $toadd]
  560.     if {${html::WrapPos} > $fillColumn} {
  561.         set ind [html::GetIndent ${html::AbsPos}]
  562.         set html::WrapPos [string length "[text::maxSpaceForm $ind]$toadd"]
  563.         return "\r$toadd"
  564.     } else {
  565.         return " $toadd"
  566.     }
  567. }
  568.  
  569. # Add quotes to attribute
  570. proc html::AddQuotes {v} {
  571.     if {[regexp {\"} $v]} {
  572.         if {[regexp {\'} $v]} {
  573.             regsub -all {\"} $v {\"} v
  574.             return \"$v\"
  575.         }
  576.         return \'$v\'
  577.     }
  578.     return \"$v\"
  579. }
  580.  
  581.  
  582. #===============================================================================
  583. # ◊◊◊◊ Build dialog procs ◊◊◊◊ #
  584. #===============================================================================
  585.  
  586. # flag 
  587. proc html::BuildDialogflag {elem attr v b hp wp bt ba ind maxHeight} {
  588.     upvar $v val $b box $hp hpos $wp wpos $ind index
  589.     if {[expr {$hpos + 20}] > $maxHeight && $wpos < 20 && $page < 3} {error "end of page"}
  590.     lappend box -c $attr [lindex $val $index] $wpos $hpos [expr {$wpos + 100}] [expr {$hpos + 15}]
  591.     incr index 
  592.     if {$wpos > 20} { 
  593.         incr hpos 25
  594.         set wpos 10
  595.     } else {
  596.         set wpos 230
  597.     }
  598. }
  599.  
  600. # url 
  601. proc html::BuildDialogurl {elem attr v b hp wp bt ba ind maxHeight} {
  602.     upvar $v val $b box $hp hpos $wp wpos $bt buttons $ba buttonAction $ind index
  603.     global HTMLmodeVars
  604.     if {$wpos > 20} { incr hpos 25 ; set wpos 10}
  605.     if {[expr {$hpos + 45}] > $maxHeight && $page < 3} {error "end of page"}
  606.     lappend box -t $attr 10 $hpos 120 [expr {$hpos + 15}] \
  607.       -e [lindex $val $index] 120 $hpos 450 [expr {$hpos + 15}] \
  608.       -m [concat [list [lindex $val [expr {$index + 1}]] { }] $HTMLmodeVars(URLs)] \
  609.       120 [expr {$hpos + 25}] 450 [expr {$hpos + 45}] \
  610.       -b "File…" 10 [expr {$hpos + 20}] 70 [expr {$hpos + 40}]
  611.     incr index 3
  612.     incr hpos 50
  613.     lappend buttons [expr {$index - 1}]
  614.     if {$elem == "IMG" && $attr == "SRC="} {
  615.         set buttonAction([expr {$index - 1}]) html::FileButtonIMGSRC
  616.     } else {
  617.         set buttonAction([expr {$index - 1}]) html::FileButton
  618.     }
  619. }
  620.  
  621. # color 
  622. proc html::BuildDialogcolor {elem attr v b hp wp bt ba ind maxHeight} {
  623.     upvar $v val $b box $hp hpos $wp wpos $bt buttons $ba buttonAction $ind index
  624.     global html::userColors html::basicColors
  625.     
  626.     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  627.     if {[expr {$hpos + 25}] > $maxHeight && $page < 3} {error "end of page"}
  628.     set htmlColors [lsort [array names html::userColors]]
  629.     append htmlColors " - " ${html::basicColors}
  630.     set ex 0
  631.     if {[string length $attr] > 14} {set ex 20}
  632.     lappend box -t $attr 10 $hpos [expr {120 + $ex}] [expr {$hpos + 15}] \
  633.       -e [lindex $val $index] [expr {120+ $ex}] $hpos [expr {190 + $ex}] [expr {$hpos + 15}] \
  634.       -m [concat [list [lindex $val [expr {$index + 1}]] { }] $htmlColors] \
  635.       [expr {200 + $ex}] $hpos 340 [expr {$hpos + 20}] \
  636.       -b "New Color…" 350 $hpos 450 [expr {$hpos + 20}]
  637.     incr index 3
  638.     incr hpos 30
  639.     lappend buttons [expr {$index - 1}]
  640.     set buttonAction([expr {$index - 1}]) html::ColorButton
  641. }
  642.  
  643. # frametarget 
  644. proc html::BuildDialogframetarget {elem attr v b hp wp bt ba ind maxHeight} {
  645.     upvar $v val $b box $hp hpos $wp wpos $ind index
  646.     global HTMLmodeVars
  647.     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  648.     if {[expr {$hpos + 25}] > $maxHeight && $page < 3} {error "end of page"}
  649.     set Windows {_self _top _parent _blank}
  650.     if {[llength $HTMLmodeVars(windows)]} {append Windows " - " $HTMLmodeVars(windows)}
  651.     lappend box -t $attr 10 $hpos 120 [expr {$hpos + 15}] \
  652.       -e [lindex $val $index] 120 $hpos 240 [expr {$hpos + 15}] \
  653.       -m [concat [list [lindex $val [expr {$index + 1}]] { }] $Windows] \
  654.       250 $hpos 440 [expr {$hpos + 20}]
  655.     incr index 2
  656.     incr hpos 30
  657. }
  658.  
  659. # choices 
  660. proc html::BuildDialogchoices {elem attr v b hp wp bt ba ind maxHeight} {
  661.     upvar $v val $b box $hp hpos $wp wpos $ind index
  662.     if {[expr {$hpos + 20}] > $maxHeight && $wpos < 20 && $page < 3} {error "end of page"}
  663.     lappend box -t $attr $wpos $hpos [expr {$wpos + 100}] [expr {$hpos + 15}] \
  664.       -m [concat [list [lindex $val $index] { }] [html::GetAttrChoices $elem $attr]] \
  665.       [expr {$wpos + 110}] $hpos [expr {$wpos + 205}] [expr {$hpos + 20}]
  666.     incr index 
  667.     if {$wpos > 20} { 
  668.         incr hpos 25 
  669.         set wpos 10
  670.     } else {
  671.         set wpos 230
  672.     }
  673. }
  674.  
  675. # length 
  676. proc html::BuildDialoglength {elem attr v b hp wp bt ba ind maxHeight} {
  677.     upvar $v val $b box $hp hpos $wp wpos $ind index
  678.     upvar widthIndex widthIndex heightIndex heightIndex
  679.     if {[expr {$hpos + 20}] > $maxHeight && $wpos < 20 && $page < 3} {error "end of page"}
  680.     if {$attr == "WIDTH="} {set widthIndex $index}
  681.     if {$attr == "HEIGHT="} {set heightIndex $index}
  682.     lappend box -t $attr $wpos $hpos [expr {$wpos + 100}] [expr {$hpos + 15}] \
  683.       -e [lindex $val $index] [expr {$wpos + 110}] $hpos [expr {$wpos + 150}] [expr {$hpos + 15}]
  684.     incr index 
  685.     if {$wpos > 20} { 
  686.         incr hpos 25
  687.         set wpos 10
  688.     } else {
  689.         set wpos 230
  690.     }
  691. }
  692.  
  693. # integer 
  694. proc html::BuildDialoginteger {elem attr v b hp wp bt ba ind maxHeight} {
  695.     upvar $v val $b box $hp hpos $wp wpos $ind index
  696.     html::BuildDialoglength $elem $attr val box hpos wpos bt ba index $maxHeight
  697. }
  698.  
  699. # other 
  700. proc html::BuildDialogother {elem attr v b hp wp bt ba ind maxHeight} {
  701.     upvar $v val $b box $hp hpos $wp wpos $ind index
  702.     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  703.     if {[expr {$hpos + 20}] > $maxHeight && $page < 3} {error "end of page"}
  704.     lappend box -t $attr 10 $hpos 120 [expr {$hpos + 15}] \
  705.       -e [lindex $val $index] 120 $hpos 450 [expr {$hpos + 15}] 
  706.     incr index
  707.     incr hpos 25
  708. }
  709.  
  710. # othernotrim
  711. proc html::BuildDialogothernotrim {elem attr v b hp wp bt ba ind maxHeight} {
  712.     upvar $v val $b box $hp hpos $wp wpos $ind index
  713.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  714. }
  715.  
  716. # id
  717. proc html::BuildDialogid {elem attr v b hp wp bt ba ind maxHeight} {
  718.     upvar $v val $b box $hp hpos $wp wpos $ind index
  719.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  720. }
  721.  
  722. # ids
  723. proc html::BuildDialogids {elem attr v b hp wp bt ba ind maxHeight} {
  724.     upvar $v val $b box $hp hpos $wp wpos $ind index
  725.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  726. }
  727.  
  728. # anchor
  729. proc html::BuildDialoganchor {elem attr v b hp wp bt ba ind maxHeight} {
  730.     upvar $v val $b box $hp hpos $wp wpos $ind index
  731.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  732. }
  733.  
  734. # targetname
  735. proc html::BuildDialogtargetname {elem attr v b hp wp bt ba ind maxHeight} {
  736.     upvar $v val $b box $hp hpos $wp wpos $ind index
  737.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  738. }
  739.  
  740. # contenttype 
  741. proc html::BuildDialogcontenttype {elem attr v b hp wp bt ba ind maxHeight} {
  742.     upvar $v val $b box $hp hpos $wp wpos $ind index
  743.     global HTMLmodeVars
  744.     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  745.     if {[expr {$hpos + 25}] > $maxHeight && $page < 3} {error "end of page"}
  746.     set ct ""
  747.     if {[llength $HTMLmodeVars(contenttypes)]} {append ct $HTMLmodeVars(contenttypes)}
  748.     lappend box -t $attr 10 $hpos 120 [expr {$hpos + 15}] \
  749.       -e [lindex $val $index] 120 $hpos 240 [expr {$hpos + 15}] \
  750.       -m [concat [list [lindex $val [expr {$index + 1}]] { }] $ct] \
  751.       250 $hpos 440 [expr {$hpos + 20}]
  752.     incr index 2
  753.     incr hpos 30
  754. }
  755.  
  756. # contenttypes
  757. proc html::BuildDialogcontenttypes {elem attr v b hp wp bt ba ind maxHeight {types contenttypes}} {
  758.     upvar $v val $b box $hp hpos $wp wpos $ind index $bt buttons $ba buttonAction
  759.     global HTMLmodeVars
  760.     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  761.     if {[expr {$hpos + 45}] > $maxHeight && $page < 3} {error "end of page"}
  762.     lappend box -t $attr 10 $hpos 120 [expr {$hpos + 15}] \
  763.       -m [concat [list [lindex $val $index] { }] $HTMLmodeVars($types)] 120 $hpos 250 [expr {$hpos + 20}] \
  764.       -e [lindex $val [expr {$index + 1}]] 120 [expr {$hpos + 25}] 450 [expr {$hpos + 40}] \
  765.       -b Add 260 $hpos 320 [expr {$hpos + 20}]
  766.     lappend buttons [expr {$index + 2}]
  767.     set buttonAction([expr {$index + 2}]) html::Add${types}Button
  768.     incr index 3
  769.     incr hpos 50
  770. }
  771.  
  772. # eventhandler 
  773. proc html::BuildDialogeventhandler {elem attr v b hp wp bt ba ind maxHeight} {
  774.     upvar $v val $b box $hp hpos $wp wpos $ind index
  775.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  776. }
  777.  
  778. # linktypes 
  779. proc html::BuildDialoglinktypes {elem attr v b hp wp bt ba ind maxHeight} {
  780.     upvar $v val $b box $hp hpos $wp wpos $ind index $bt buttons $ba buttonAction
  781.     html::BuildDialogcontenttypes $elem $attr val box hpos wpos buttons buttonAction index $maxHeight linktypes
  782. }
  783.  
  784. # multilength 
  785. proc html::BuildDialogmultilength {elem attr v b hp wp bt ba ind maxHeight} {
  786.     upvar $v val $b box $hp hpos $wp wpos $ind index
  787.     html::BuildDialoglength $elem $attr val box hpos wpos bt ba index $maxHeight
  788. }
  789.  
  790. # multilengths 
  791. proc html::BuildDialogmultilengths {elem attr v b hp wp bt ba ind maxHeight} {
  792.     upvar $v val $b box $hp hpos $wp wpos $ind index
  793.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  794.     # to be modified
  795. }
  796.  
  797. # languagecode 
  798. proc html::BuildDialoglanguagecode {elem attr v b hp wp bt ba ind maxHeight} {
  799.     upvar $v val $b box $hp hpos $wp wpos $ind index
  800.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  801.     # to be modified
  802. }
  803.  
  804. # charset 
  805. proc html::BuildDialogcharset {elem attr v b hp wp bt ba ind maxHeight} {
  806.     upvar $v val $b box $hp hpos $wp wpos $ind index
  807.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  808.     # to be modified
  809. }
  810.  
  811. # charsets 
  812. proc html::BuildDialogcharsets {elem attr v b hp wp bt ba ind maxHeight} {
  813.     upvar $v val $b box $hp hpos $wp wpos $ind index
  814.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  815.     # to be modified
  816. }
  817.  
  818. # coords 
  819. proc html::BuildDialogcoords {elem attr v b hp wp bt ba ind maxHeight} {
  820.     upvar $v val $b box $hp hpos $wp wpos $ind index
  821.     html::BuildDialogother $elem $attr val box hpos wpos bt ba index $maxHeight
  822.     # to be modified
  823. }
  824.  
  825. # oltype 
  826. proc html::BuildDialogoltype {elem attr v b hp wp bt ba ind maxHeight} {
  827.     upvar $v val $b box $hp hpos $wp wpos $ind index
  828.     html::BuildDialogchoices $elem $attr val box hpos wpos bt ba index $maxHeight
  829. }
  830.  
  831. # datetime 
  832. proc html::BuildDialogdatetime {elem attr v b hp wp bt ba ind maxHeight} {
  833.     upvar $v val $b box $hp hpos $wp wpos $ind index
  834.     # Any other
  835.     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  836.     if {[expr {$hpos + 45}] > $maxHeight && $page < 3} {error "end of page"}
  837.     lappend box -t $attr 10 $hpos 120 [set h [expr {$hpos + 15}]] \
  838.       -e [lindex $val $index] 120 $hpos 155 $h \
  839.       -t "-" 165 $hpos 175 $h -e [lindex $val [expr {$index + 1}]] 183 $hpos 203 $h \
  840.       -t "-" 213 $hpos 223 $h -e [lindex $val [expr {$index + 2}]] 231 $hpos 251 $h \
  841.       -t "T" 261 $hpos 271 $h -e [lindex $val [expr {$index + 3}]] 279 $hpos 299 $h \
  842.       -t ":" 309 $hpos 319 $h -e [lindex $val [expr {$index + 4}]] 325 $hpos 345 $h \
  843.       -t ":" 355 $hpos 365 $h -e [lindex $val [expr {$index + 5}]] 371 $hpos 391 $h \
  844.       -e [lindex $val [expr {$index + 6}]] 405 $hpos 450 $h \
  845.       -c "Current time" [lindex $val [expr {$index + 7}]] 120 [expr {$hpos + 25}] 300 [expr {$h + 25}]
  846.     incr index 8
  847.     incr hpos 50
  848. }
  849.  
  850. # character 
  851. proc html::BuildDialogcharacter {elem attr v b hp wp bt ba ind maxHeight} {
  852.     upvar $v val $b box $hp hpos $wp wpos $ind index
  853.     html::BuildDialoglength $elem $attr val box hpos wpos bt ba index $maxHeight
  854. }
  855.  
  856. # mediadesc 
  857. proc html::BuildDialogmediadesc {elem attr v b hp wp bt ba ind maxHeight} {
  858.     upvar $v val $b box $hp hpos $wp wpos $ind index $bt buttons $ba buttonAction
  859.     html::BuildDialogcontenttypes $elem $attr val box hpos wpos buttons buttonAction index $maxHeight mediatypes
  860. }
  861.  
  862.  
  863. #===============================================================================
  864. # ◊◊◊◊ Button actions ◊◊◊◊ #
  865. #===============================================================================
  866.  
  867. proc html::ColorButton {v index} {
  868.     upvar $v val
  869.     if {[set newColor [html::AddANewColor]] != ""} {
  870.         if {[string index $newColor 0] == "#"} {
  871.             set val [lreplace $val [incr index -2] $index "$newColor"]
  872.         } else {
  873.             set val [lreplace $val [incr index -1] $index "$newColor"]
  874.         }
  875.     }
  876. }
  877.  
  878. proc html::FileButton {v index} {
  879.     upvar $v val
  880.     if {[set newFile [html::GetFile]] != ""} {
  881.         set val [lreplace $val [incr index -1] $index [lindex $newFile 0]]
  882.     }
  883.     return $newFile
  884. }
  885.  
  886. proc html::FileButtonIMGSRC {v index} {
  887.     upvar $v val widthIndex widthIndex heightIndex heightIndex
  888.     set newFile [html::FileButton val $index]
  889.     if {[llength [set widhei [lindex $newFile 1]]]} {
  890.         if {$widthIndex >= 0} {set val [lreplace $val $widthIndex $widthIndex [lindex $widhei 0]]}
  891.         if {$heightIndex >= 0} {set val [lreplace $val $heightIndex $heightIndex [lindex $widhei 1]]}
  892.     }
  893. }
  894.  
  895. proc html::AddcontenttypesButton {v index} {
  896.     upvar $v val
  897.     if {[set f [lindex $val [expr {$index - 2}]]] != " "} {
  898.         set fm [string trim [join [list [lindex $val [expr {$index - 1}]] $f] ", "] ", "]
  899.         set val [lreplace $val [expr {$index - 2}] [expr {$index - 1}] " " $fm]
  900.     }    
  901. }
  902.  
  903. proc html::AddmediatypesButton {v index} {
  904.     upvar $v val
  905.     html::AddcontenttypesButton val $index
  906. }
  907.  
  908. proc html::AddlinktypesButton {v index} {
  909.     upvar $v val
  910.     if {[set f [lindex $val [expr {$index - 2}]]] != " "} {
  911.         set fm [string trim [join [list [lindex $val [expr {$index - 1}]] $f] " "]]
  912.         set val [lreplace $val [expr {$index - 2}] [expr {$index - 1}] " " $fm]
  913.     }    
  914. }
  915.  
  916. #===============================================================================
  917. # ◊◊◊◊ Reading dialog values ◊◊◊◊ #
  918. #===============================================================================
  919.  
  920. # flag 
  921. proc html::ReadDialogflag {elem attr v ind etext} {
  922.     upvar $v val $ind index
  923.     set attrtext ""
  924.     if {[lindex $val $index]} {        
  925.         set attrtext [html::WrapTag [html::SetCase $attr]]
  926.     }
  927.     incr index
  928.     return $attrtext
  929. }
  930.  
  931. # url 
  932. proc html::ReadDialogurl {elem attr v ind etext} {
  933.     upvar $v val $ind index
  934.     set attrtext ""
  935.     set texturl [string trim [lindex $val $index]]
  936.     set menuurl [lindex $val [expr {$index + 1}]]
  937.     if {[string length $texturl]} {        
  938.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes [html::URLescape2 $texturl]]"]
  939.         html::AddToCache URLs $texturl
  940.     } elseif {$menuurl != " "} {
  941.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes [html::URLescape2 $menuurl]]"] 
  942.     }
  943.     incr index 3
  944.     return $attrtext
  945. }
  946.  
  947. # color 
  948. proc html::ReadDialogcolor {elem attr v ind etext} {
  949.     upvar $v val $ind index
  950.     global html::userColors html::ColorName
  951.     set attrtext ""
  952.     set colortxt [lindex $val $index]
  953.     set colorval [lindex $val [expr {$index + 1}]]
  954.     if {[string length $colortxt]} {
  955.         set col [html::CheckColorNumber $colortxt]
  956.         if {$col == 0} {
  957.             lappend errtext "$attr: $colortxt is not a valid color number."
  958.         } else {    
  959.             set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $col]"]
  960.         }
  961.     } elseif {$colorval != " "} {
  962.         # Users own color?
  963.         if {[info exists html::userColors($colorval)]} {
  964.             set colornum [set html::userColors($colorval)]
  965.         }
  966.         # Predefined color?
  967.         if {[info exists html::ColorName($colorval)]} {
  968.             set colornum [set html::ColorName($colorval)]
  969.         }
  970.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $colornum]"]
  971.     }
  972.     incr index 3
  973.     return $attrtext
  974. }
  975.  
  976. # frametarget 
  977. proc html::ReadDialogframetarget {elem attr v ind etext} {
  978.     upvar $v val $ind index
  979.     set attrtext ""
  980.     set textwin [string trim [lindex $val $index]]
  981.     set menuwin [lindex $val [expr {$index + 1}]]
  982.     if {[string length $textwin]} {        
  983.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $textwin]"]
  984.         html::AddToCache windows $textwin
  985.     } elseif {$menuwin != " "} {
  986.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $menuwin]"]
  987.     }
  988.     incr index 2
  989.     return $attrtext
  990. }
  991.  
  992. # choices 
  993. proc html::ReadDialogchoices {elem attr v ind etext} {
  994.     upvar $v val $ind index
  995.     return [html::ReadDialogother $elem $attr val index errtext]
  996. }
  997.  
  998. # length 
  999. proc html::ReadDialoglength {elem attr v ind etext {multilength 0}} {
  1000.     upvar $v val $ind index $etext errtext
  1001.     set attrtext ""
  1002.     if {[set numval [string trim [lindex $val $index]]] != ""} {
  1003.         if {[set res [html::CheckAttrNumber $elem $attr $numval 1 $multilength]] == "1"} {        
  1004.             set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $numval]"]
  1005.         } else {
  1006.             lappend errtext "$attr: $res"
  1007.         }
  1008.     }
  1009.     incr index
  1010.     return $attrtext
  1011. }
  1012.  
  1013. # integer
  1014. proc html::ReadDialoginteger {elem attr v ind etext} {
  1015.     upvar $v val $ind index $etext errtext
  1016.     set attrtext ""
  1017.     if {[set numval [string trim [lindex $val $index]]] != ""} {
  1018.         if {[set res [html::CheckAttrNumber $elem $attr $numval 0]] == "1"} {        
  1019.             set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $numval]"]
  1020.         } else {
  1021.             lappend errtext "$attr: $res"
  1022.         }
  1023.     }
  1024.     incr index
  1025.     return $attrtext
  1026. }
  1027.  
  1028. # other 
  1029. proc html::ReadDialogother {elem attr v ind etext} {
  1030.     upvar $v val $ind index
  1031.     set attrtext ""
  1032.     if {[set anyval [string trim [lindex $val $index]]] != ""} {
  1033.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $anyval]"]
  1034.     }
  1035.     incr index
  1036.     return $attrtext
  1037. }
  1038.  
  1039. # othernotrim
  1040. proc html::ReadDialogothernotrim {elem attr v ind etext} {
  1041.     upvar $v val $ind index
  1042.     set attrtext ""
  1043.     set anyval [lindex $val $index]
  1044.     if {$anyval != ""} {
  1045.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $anyval]"]
  1046.     }
  1047.     incr index
  1048.     return $attrtext
  1049. }
  1050.  
  1051. # id
  1052. proc html::ReadDialogid {elem attr v ind etext} {
  1053.     upvar $v val $ind index $etext errtext
  1054.     set attrtext ""
  1055.     if {[set idval [string trim [lindex $val $index]]] != ""} {
  1056.         if {[html::CheckId $idval]} {        
  1057.             set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $idval]"]
  1058.         } else {
  1059.             lappend errtext "$attr: Must be first a letter and then letters, digits, and '_' '-' ':' '.'"
  1060.         }
  1061.     }
  1062.     incr index
  1063.     return $attrtext
  1064. }
  1065.  
  1066. # ids
  1067. proc html::ReadDialogids {elem attr v ind etext} {
  1068.     upvar $v val $ind index $etext errtext
  1069.     set attrtext ""
  1070.     if {[set idval [string trim [lindex $val $index]]] != ""} {
  1071.         if {[html::CheckIds $idval]} {        
  1072.             set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $idval]"]
  1073.         } else {
  1074.             lappend errtext "$attr: Must be first a letter and then letters, digits, and '_' '-' ':' '.'"
  1075.         }
  1076.     }
  1077.     incr index
  1078.     return $attrtext
  1079. }
  1080.  
  1081. # anchor
  1082. proc html::ReadDialoganchor {elem attr v ind etext} {
  1083.     upvar $v val $ind index
  1084.     set attrtext ""
  1085.     set anyval [string trim [lindex $val $index]]
  1086.     if {$anyval != ""} {
  1087.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $anyval]"]
  1088.         html::AddToCache URLs "#$anyval"
  1089.     }
  1090.     incr index
  1091.     return $attrtext
  1092. }
  1093.  
  1094. # targetname
  1095. proc html::ReadDialogtargetname {elem attr v ind etext} {
  1096.     upvar $v val $ind index
  1097.     set attrtext ""
  1098.     set anyval [string trim [lindex $val $index]]
  1099.     if {$anyval != ""} {
  1100.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $anyval]"]
  1101.         html::AddToCache windows $anyval
  1102.     }
  1103.     incr index
  1104.     return $attrtext
  1105. }
  1106.  
  1107. # contenttype 
  1108. proc html::ReadDialogcontenttype {elem attr v ind etext} {
  1109.     upvar $v val $ind index
  1110.     global HTMLmodeVars
  1111.     set attrtext ""
  1112.     set textwin [string trim [lindex $val $index]]
  1113.     set menuwin [lindex $val [expr {$index + 1}]]
  1114.     if {$textwin != ""} {
  1115.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $textwin]"]
  1116.         if {![lcontains HTMLmodeVars(contenttypes) [string tolower $textwin]]} {
  1117.             lappend HTMLmodeVars(contenttypes) [string tolower $textwin]
  1118.             prefs::modifiedModeVar contenttypes HTML
  1119.         }
  1120.     } elseif {$menuwin != " "} {
  1121.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $menuwin]"]
  1122.     }
  1123.     incr index 2
  1124.     return $attrtext
  1125. }
  1126.  
  1127. # contenttypes
  1128. proc html::ReadDialogcontenttypes {elem attr v ind etext {types contenttypes} {comma 1}} {
  1129.     upvar $v val $ind index
  1130.     global HTMLmodeVars
  1131.     set attrtext ""
  1132.     set menuwin [lindex $val $index]
  1133.     set textwin [string trim [lindex $val [expr {$index + 1}]]]
  1134.     set aval ""
  1135.     if {$menuwin != " "} {
  1136.         set aval $menuwin
  1137.     }
  1138.     if {$textwin != ""} {
  1139.         if {$comma && $aval != ""} {append aval ,}
  1140.         append aval " " $textwin
  1141.         if {$comma} {
  1142.             set tlist [split $textwin ,]
  1143.         } else {
  1144.             set tlist $textwin
  1145.         }
  1146.         foreach t $tlist {
  1147.             set t [string tolower [string trim $t]]
  1148.             if {![lcontains HTMLmodeVars($types) $t]} {
  1149.                 lappend HTMLmodeVars($types) $t
  1150.                 prefs::modifiedModeVar $types HTML
  1151.             }
  1152.         }
  1153.     }
  1154.     if {$aval != ""} {
  1155.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes [string trim $aval]]"]
  1156.     }
  1157.     incr index 3
  1158.     return $attrtext
  1159. }
  1160.  
  1161. # eventhandler 
  1162. proc html::ReadDialogeventhandler {elem attr v ind etext} {
  1163.     upvar $v val $ind index
  1164.     set attrtext ""
  1165.     set anyval [string trim [lindex $val $index]]
  1166.     if {$anyval != ""} {
  1167.         set attrtext [html::WrapTag "$attr[html::AddQuotes $anyval]"]
  1168.     }
  1169.     incr index
  1170.     return $attrtext
  1171. }
  1172.  
  1173. # linktypes 
  1174. proc html::ReadDialoglinktypes {elem attr v ind etext} {
  1175.     upvar $v val $ind index
  1176.     return [html::ReadDialogcontenttypes $elem $attr val index errtext linktypes 0]
  1177. }
  1178.  
  1179. # multilength 
  1180. proc html::ReadDialogmultilength {elem attr v ind etext} {
  1181.     upvar $v val $ind index $etext errtext
  1182.     return [html::ReadDialoglength $elem $attr val index errtext 1]
  1183. }
  1184.  
  1185.  
  1186. # multilengths 
  1187. proc html::ReadDialogmultilengths {elem attr v ind etext} {
  1188.     upvar $v val $ind index $etext errtext
  1189.     return [html::ReadDialogcoords $elem $attr val index errtext 1]
  1190. }
  1191.  
  1192. # languagecode 
  1193. proc html::ReadDialoglanguagecode {elem attr v ind etext} {
  1194.     upvar $v val $ind index $etext errtext
  1195.     return [html::ReadDialogother $elem $attr val index errtext]
  1196.     # to be modified
  1197. }
  1198.  
  1199. # charset 
  1200. proc html::ReadDialogcharset {elem attr v ind etext} {
  1201.     upvar $v val $ind index
  1202.     return [html::ReadDialogother $elem $attr val index errtext]
  1203.     # to be modified
  1204. }
  1205.  
  1206. # charsets 
  1207. proc html::ReadDialogcharsets {elem attr v ind etext} {
  1208.     upvar $v val $ind index
  1209.     return [html::ReadDialogother $elem $attr val index errtext]
  1210.     # to be modified
  1211. }
  1212.  
  1213. # coords 
  1214. proc html::ReadDialogcoords {elem attr v ind etext {multilength 0}} {
  1215.     upvar $v val $ind index $etext errtext
  1216.     set attrtext ""
  1217.     if {[set numval [string trim [lindex $val $index]]] != ""} {
  1218.         set atxt ""
  1219.         set err 0
  1220.         foreach l [split $numval ,] {
  1221.             set l [string trim $l]
  1222.             if {[set res [html::CheckAttrNumber $elem $attr $l 1 $multilength]] == "1"} {
  1223.                 append atxt ",$l"
  1224.             } else {
  1225.                 lappend errtext "$attr: $res"
  1226.                 set err 1
  1227.                 break
  1228.             }
  1229.         }
  1230.         if {!$err} {
  1231.             set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes [string trim $atxt ,]]"]
  1232.         }
  1233.     }
  1234.     incr index
  1235.     return $attrtext
  1236. }
  1237.  
  1238. # oltype 
  1239. proc html::ReadDialogoltype {elem attr v ind etext} {
  1240.     upvar $v val $ind index
  1241.     set attrtext ""
  1242.     if {[set choiceval [lindex $val $index]] != " "} {        
  1243.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $choiceval]"]
  1244.     }
  1245.     incr index
  1246.     return $attrtext
  1247. }
  1248.  
  1249. # datetime 
  1250. proc html::ReadDialogdatetime {elem attr v ind etext} {
  1251.     upvar $v val $ind index $etext errtext
  1252.     set attrtext ""
  1253.     if {[lindex $val [expr {$index + 7}]]} {
  1254.         set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes [html::ISOtime]]"]
  1255.     } elseif {[join [set date [lrange $val $index [expr {$index + 6}]]] ""] != ""} {
  1256.         if {![catch {html::CheckDateTime $date} res]} {
  1257.             set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $res]"]
  1258.         } else {
  1259.             lappend errtext "$attr: $res"
  1260.         }
  1261.     }
  1262.     incr index 8
  1263.     return $attrtext
  1264. }
  1265.  
  1266. # character 
  1267. proc html::ReadDialogcharacter {elem attr v ind etext} {
  1268.     upvar $v val $ind index $etext errtext
  1269.     set attrtext ""
  1270.     if {[set char [string trim [lindex $val $index]]] != ""} {
  1271.         if {[string length $char] == 1} {        
  1272.             set attrtext [html::WrapTag "[html::SetCase $attr][html::AddQuotes $char]"]
  1273.         } else {
  1274.             lappend errtext "$attr: Only a single character is allowed."
  1275.         }
  1276.     }
  1277.     incr index
  1278.     return $attrtext
  1279. }
  1280.  
  1281. # mediadesc 
  1282. proc html::ReadDialogmediadesc {elem attr v ind etext} {
  1283.     upvar $v val $ind index
  1284.     return [html::ReadDialogcontenttypes $elem $attr val index errtext mediatypes]
  1285. }
  1286.  
  1287. #===============================================================================
  1288. # ◊◊◊◊ Checking attr values ◊◊◊◊ #
  1289. #===============================================================================
  1290.  
  1291. # Check if a color number is a valid number, or one of the predefined names.
  1292. # Returns 0 if not and the color number if it is.
  1293. proc html::CheckColorNumber {color} {
  1294.     global html::ColorName html::userColors
  1295.     set color [string tolower $color]
  1296.     if {[info exists html::ColorName($color)]} {return [set html::ColorName($color)]}
  1297.     if {[info exists html::userColors($color)]} {return [set html::userColors($color)]}
  1298.     if {[string index $color 0] != "#"} {
  1299.         set color "#${color}"
  1300.     }
  1301.     set color [string toupper $color]
  1302.     if {[string length $color] != 7 || ![regexp {^#[0-9A-F]+$} $color]} {
  1303.         return 0
  1304.     } else {
  1305.         return $color
  1306.     }    
  1307. }
  1308.  
  1309. # Check if a input is a valid number for the element attribute.
  1310. # Returns 1 if it is, otherwise returns an error message.
  1311. proc html::CheckAttrNumber {item attr number procent {multilength 0}} {
  1312.     regexp {^([-i0-9]+):([-i0-9]+)} [html::GetAttrRange $item $attr] "" minvalue maxvalue
  1313.     if {$minvalue == "-i"} {
  1314.         set errtext "An integer"
  1315.     } elseif {$maxvalue == "i"} {
  1316.         set errtext "A number $minvalue or greater"
  1317.     } else {
  1318.         set errtext "A number in the range $minvalue to $maxvalue"
  1319.     }
  1320.     if {$item == "FONT"} {append errtext " or -6 to +6"}
  1321.     if {$procent} {append errtext " or percentage"}
  1322.     if {$multilength} {append errtext " or a relative length"}
  1323.     append errtext  " expected." 
  1324.     # Is percent allowed?
  1325.     if {[string index $number [expr {[string length $number] - 1}]] == "%" } {
  1326.         set number [string range $number 0 [expr {[string length $number] - 2}]]
  1327.         if {!$procent} {return $errtext}
  1328.     }
  1329.     # Is multilength allowed?
  1330.     if {[string index $number [expr {[string length $number] - 1}]] == "*" } {
  1331.         if {$number == "*"} {set number "1*"}
  1332.         set number [string range $number 0 [expr {[string length $number] - 2}]]
  1333.         if {!$multilength} {return $errtext}
  1334.     }
  1335.     # FONT can take values -6 - +6. Special case.
  1336.     if {$item == "FONT" && [regexp {^(\+|-)[1-6]$} $number]} {return 1}
  1337.     # Is input a number?
  1338.     if {![regexp {^(\+|-)?[0-9]+$} $number]} {return $errtext}
  1339.     # Is input in the valid range?
  1340.     if {( $maxvalue != "i" && $number > $maxvalue ) || ( $minvalue != "-i" && $number < $minvalue ) } {
  1341.         return $errtext
  1342.     }    
  1343.     return 1 
  1344. }
  1345.  
  1346. proc html::CheckDateTime {date} {
  1347.     if {[string length [set d [lindex $date 0]]] != 4 || ![is::PositiveInteger $d]} {error "Year must be four digits."}
  1348.     if {![is::PositiveInteger [set x [lindex $date 1]]] || $x < 1 || $x > 12} {error "Incorrect month."}
  1349.     if {$x < 10} {set x "0[expr $x]"}
  1350.     append d "-$x"
  1351.     if {![is::PositiveInteger [set x [lindex $date 2]]] || $x < 1 || $x > 31} {error "Incorrect day."}
  1352.     if {$x < 10} {set x "0[expr $x]"}
  1353.     append d "-$x"
  1354.     if {![is::UnsignedInteger [set x [lindex $date 3]]] || $x < 0 || $x > 23} {error "Incorrect hours."}
  1355.     if {$x < 10} {set x "0[expr $x]"}
  1356.     append d "T$x"
  1357.     if {![is::UnsignedInteger [set x [lindex $date 4]]] || $x < 0 || $x > 59} {error "Incorrect minutes."}
  1358.     if {$x < 10} {set x "0[expr $x]"}
  1359.     append d ":$x"
  1360.     if {![is::UnsignedInteger [set x [lindex $date 5]]] || $x < 0 || $x > 59} {error "Incorrect seconds."}
  1361.     if {$x < 10} {set x "0[expr $x]"}
  1362.     append d ":$x"
  1363.     if {[set x [lindex $date 6]] != "Z" && ![regexp {^[-+][0-9][0-9]:[0-9][0-9]$} $x]} {error "Incorrect time zone designator."}
  1364.     append d $x
  1365.     return $d
  1366. }
  1367.  
  1368. proc html::CheckId {id} {
  1369.     return [regexp {^[A-Za-z][-A-Za-z0-9_:\.]*$} $id]
  1370. }
  1371.  
  1372. proc html::CheckIds {ids} {
  1373.     return [regexp {^[A-Za-z][-A-Za-z0-9_:\.]*([ \t\r\n]+[A-Za-z][-A-Za-z0-9_:\.]*)*$} $ids]
  1374. }
  1375.  
  1376. #===============================================================================
  1377. # ◊◊◊◊ Some extra tests of dialog input ◊◊◊◊ #
  1378. #===============================================================================
  1379.  
  1380. proc html::OneIsRequired {elem text cmd} {
  1381.     if {[string toupper $text] == "<$elem"} {  
  1382.         eval {$cmd "At least one of the attributes is required."}
  1383.         return 1
  1384.     }
  1385.     return 0
  1386. }
  1387.  
  1388. # CODE or OBJECT must be used for APPLET
  1389. proc html::APPLETtest {elem text cmd} {
  1390.     if {![regexp -nocase {code=} $text] && ![regexp -nocase {object=} $text]} {
  1391.         eval {$cmd "At least one of the attributes CODE and OBJECT must be used."}
  1392.         return 1
  1393.     }
  1394.     return 0
  1395. }
  1396.  
  1397. proc html::FONTtest {elem text cmd} {
  1398.     return [html::OneIsRequired $elem $text $cmd]
  1399. }
  1400.  
  1401. proc html::BASEtest {elem text cmd} {
  1402.     if {[regexp -nocase {HREF=(\"[^\"]+\"|'[^']+')} $text "" href] && ![regexp "://" $href]} {
  1403.         eval {$cmd "The HREF URL must be absolute."}
  1404.         return 1
  1405.     }
  1406.     return [html::OneIsRequired $elem $text $cmd]
  1407. }
  1408.  
  1409. proc html::SPANtest {elem text cmd} {
  1410.     return [html::OneIsRequired $elem $text $cmd]
  1411. }
  1412.  
  1413. # Some checks for SPACER.
  1414. proc html::SPACERtest {elem text cmd} {
  1415.     set horver [regexp -nocase {type=\"(horizontal|vertical)\"} $text]
  1416.     set wh [regexp -nocase {width=|height=} $text]
  1417.     set sz [regexp -nocase {size=} $text]
  1418.     set al [regexp -nocase {align=} $text]
  1419.     set invalidInput 1
  1420.     if {$horver && ($wh || $al)} {
  1421.         eval {$cmd "WIDTH, HEIGHT and ALIGN should only be used when TYPE=BLOCK."}
  1422.     } elseif {!$horver && $sz} {
  1423.         eval {$cmd "SIZE should only be used when TYPE=HORIZONTAL or VERTICAL."}
  1424.     } elseif {$horver && !$sz} {
  1425.         eval {$cmd "SIZE is required when TYPE=HORIZONTAL or VERTICAL."}
  1426.     } elseif {!$horver && !$wh} {
  1427.         eval {$cmd "WIDTH or HEIGHT is required when TYPE=BLOCK."}
  1428.     } else {
  1429.         set invalidInput 0
  1430.     }
  1431.     return $invalidInput
  1432. }
  1433.  
  1434. # For AREA, either HREF or NOHREF must be used, but not both.
  1435. proc html::AREAtest {elem text cmd} {
  1436.     set hasHref [regexp -nocase {href=} $text]
  1437.     set hasNohref [regexp -nocase {nohref} $text]
  1438.     set hasCoords [regexp -nocase {coords=} $text]
  1439.     set shapeDefault [regexp -nocase {shape=\"default\"} $text]
  1440.     set invalidInput 0
  1441.     if {($hasHref && $hasNohref) || (!$hasHref && !$hasNohref)} {
  1442.         eval {$cmd "One of the attributes HREF and NOHREF must be used, but not both."}
  1443.         set invalidInput 1
  1444.     } elseif {!$hasCoords && !$shapeDefault} {
  1445.         eval {$cmd "COORDS= is required if SHAPE≠DEFAULT"}
  1446.         set invalidInput 1
  1447.     }
  1448.     return $invalidInput
  1449. }
  1450.